home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / dunquest.arc / DUNMAP.BAS < prev    next >
Encoding:
BASIC Source File  |  1985-10-29  |  4.8 KB  |  153 lines
  1. 10 'DUNMAP   'DRAW THE DUNGEON MAP
  2. 20    DEFINT A-Z
  3. 30    DIM S(10,2)
  4. 40    SCREEN 3
  5. 50    KEY OFF
  6. 60    WIDTH 20
  7. 70    COLOR 1,4
  8. 80    CLS
  9. 90    LOCATE 4,1
  10. 100    PRINT "       THE"
  11. 110    LOCATE 7,1
  12. 120    PRINT "       MAP"
  13. 130 'KILL TIME
  14. 140    SV.TIME! = TIMER + 5
  15. 150    IF TIMER < SV.TIME! THEN GOTO 150
  16. 160 'PRINT MENU
  17. 170    SCREEN 0
  18. 180    WIDTH 40
  19. 190    COLOR 0,2,2
  20. 200    CLS
  21. 210    LOCATE 3,1
  22. 220    PRINT "           THE MAP"
  23. 230    PRINT: PRINT: PRINT:
  24. 240    PRINT "WARNING!  THIS PROGRAM WILL ERASE"
  25. 245    PRINT "AND REPLACE"
  26. 250    PRINT "DUNGEON MAPS REQUIRED FOR PLAY"
  27. 260    PRINT "DO YOU WANT TO CONTINUE (Y/N)?"
  28. 270    GOSUB 780 'GET REPLY
  29. 280    IF REPLY$<>"Y" THEN CHAIN "MENU"
  30. 290    INPUT "ENTER MAP NUMBER ",MNO$
  31. 300    LET F$="DUNMAP"+MNO$
  32. 310    OPEN F$ FOR OUTPUT AS #1
  33. 320    PRINT "FIRST DRAW THE ROOM. WHEN FINISHED TYPE E"
  34. 330    PRINT "THEN NUMBER THE ROOMS AND TYPE E"
  35. 340    PRINT "ALL ROOMS MUST BE RECTANGULAR"
  36. 350    PRINT "THERE CAN BE 1-9 ROOMS "
  37. 360    PRINT "THE BOTTOM RIGHT MUST BE CLOSED"
  38. 370    PRINT "  (WALL OR DOOR)"
  39. 380    PRINT "THE ENTRANCE MUST BE ON LEFT SIDE"
  40. 390    PRINT "NUMBER ROOMS BY LEVEL OF "
  41. 400    PRINT "DIFFICULTY"
  42. 410    LOCATE 25,1: PRINT "HIT ANY KEY TO CONTINUE";
  43. 420    GOSUB 780 'GET REPLY
  44. 430            GOSUB 450
  45. 440    GOTO 1020
  46. 450 'DRAW THE MAP
  47. 460    V=2: H=2
  48. 470    C=219
  49. 480    CLS
  50. 490    LOCATE 25,1: PRINT "W=WALL,D=DOOR,SPACE=ERASE";
  51. 500    LOCATE 2,2
  52. 510    SV.H=POS(0): SV.V=CSRLIN
  53. 520    PRINT CHR$(94);
  54. 530    LOCATE 2,2
  55. 540 'GET COMMANDS
  56. 550    IF REPLY$ = " " OR REPLY$ = "S" OR REPLY$ = "D" OR REPLY$ = "W"                   THEN GOTO 580
  57. 560    SV.H=POS(0): SV.V=CSRLIN
  58. 570    PRINT CHR$(94);
  59. 580    GOSUB 780
  60. 590    IF REPLY$ = " " THEN C=32: GOTO 540
  61. 600    IF REPLY$ = "D" THEN C=179: GOTO 540
  62. 610    IF REPLY$ = "W" THEN C=219: GOTO 540
  63. 620    IF REPLY$ = CHR$(30) THEN V=V-1
  64. 630    IF REPLY$ = CHR$(31) THEN V=V+1
  65. 640    IF REPLY$ = CHR$(28) THEN H=H+1
  66. 650    IF REPLY$ = CHR$(29) THEN H=H-1
  67. 660    IF H> 38 THEN V=V+1: H=2
  68. 670    IF H<2 THEN V=V-1: H=38
  69. 680    IF V<2 THEN V=23
  70. 690    IF V>23 THEN V=2
  71. 700    LOCATE  SV.V,SV.H
  72. 710    IF C = 179 AND (REPLY$ = CHR$(28) OR REPLY$ = CHR$(29)) THEN C=196
  73. 720    IF REPLY$ = "E" THEN C=32
  74. 730    PRINT CHR$(C);
  75. 740    LOCATE V,H
  76. 750    IF REPLY$ = "E" THEN GOSUB 1070: GOSUB 890: GOTO 770
  77. 760    GOTO 540
  78. 770 RETURN
  79. 780 'GET COMMAND
  80. 790    REPLY$ = INKEY$
  81. 800    IF REPLY$ = "" THEN GOTO 790
  82. 810    IF LEN(REPLY$) = 1 THEN GOTO 880
  83. 820    IF LEFT$(REPLY$,1) <> CHR$(0) THEN GOTO 790
  84. 830    REPLY$=RIGHT$(REPLY$,1)
  85. 840    IF ASC(REPLY$) = 72 THEN REPLY$ = CHR$(30): GOTO 880
  86. 850    IF ASC(REPLY$) = 80 THEN REPLY$ = CHR$(31): GOTO 880
  87. 860    IF ASC(REPLY$) = 77 THEN REPLY$ = CHR$(28): GOTO 880
  88. 870    IF ASC(REPLY$) = 75 THEN REPLY$ = CHR$(29): GOTO 880
  89. 880 RETURN
  90. 890 'WRITE OUT MAP
  91. 900    S=1: CT=1: SV.C=32
  92. 910    FOR V=1 TO 24
  93. 920      FOR H = 1 TO 40
  94. 930         C=SCREEN(V,H)
  95. 940         IF C=25 THEN S(S,1) = V: S(S,2) = H:                                              SMAX=S: S=S+1
  96. 950         IF C = SV.C THEN CT=CT+1: GOTO 980
  97. 960         WRITE #1,CT,SV.C
  98. 970         SV.C = C: CT=1
  99. 980      NEXT H
  100. 990    NEXT V
  101. 1000    WRITE #1,CT,SV.C
  102. 1010 RETURN
  103. 1020 'END OF JOB
  104. 1030    CLS
  105. 1040    WRITE #1,9999,9999
  106. 1050    CLOSE
  107. 1060    END
  108. 1070 'NUMBER THE ROOMS
  109. 1080    LOCATE 25,1
  110. 1090    PRINT SPACE$(38);
  111. 1100    LOCATE 25,1:
  112. 1110    PRINT "ENTER NUMBER AT UPPER LEFT OF EACH ROOM";
  113. 1120    LOCATE 1,2
  114. 1130    V=1: H=2
  115. 1140 'MOVE AND MARK
  116. 1150    SV.H = POS(0)
  117. 1160    SV.V = CSRLIN
  118. 1170    SV.C = SCREEN(SV.V,SV.H)
  119. 1180    PRINT CHR$(94)
  120. 1190    GOSUB 780
  121. 1200    IF REPLY$ > "0" AND REPLY$ < ":"  THEN SV.C = ASC(REPLY$): GOSUB 1370:            H = H+1
  122. 1210    IF REPLY$ = CHR$(30) THEN V=V-1
  123. 1220    IF REPLY$ = CHR$(31) THEN V=V+1
  124. 1230    IF REPLY$ = CHR$(28) THEN H=H+1
  125. 1240    IF REPLY$ = CHR$(29) THEN H=H-1
  126. 1250    IF H> 39 THEN V=V+1: H=2
  127. 1260    IF H<2 THEN V=V-1: H=38
  128. 1270    IF V<1 THEN V=24
  129. 1280    IF V>24 THEN V=1
  130. 1290    LOCATE  SV.V,SV.H
  131. 1300    PRINT CHR$(SV.C);
  132. 1310    IF REPLY$ = "E" THEN GOTO 1340 'END
  133. 1320    LOCATE V,H
  134. 1330    GOTO 1140
  135. 1340 'END OF ROOMS
  136. 1350    WRITE #1,9999
  137. 1360 RETURN
  138. 1370 'GET CORD OF ROOM
  139. 1380    SV.ULV = V: SV.ULH = H
  140. 1390     CV=V:CH=H
  141. 1400 'FIND RIGHT SIDE
  142. 1410    CH=CH+1
  143. 1420    IF SCREEN(CV,CH) <> 219 AND SCREEN(CV,CH) <> 179 THEN GOTO 1400      
  144. 1430    CH=CH-1
  145. 1440 'FIND BOTTOM
  146. 1450    CV=CV+1
  147. 1460    IF SCREEN(CV,CH) <> 219 AND SCREEN(CV,CH) <> 196 THEN GOTO 1440
  148. 1470    CH=CH+2
  149. 1480    SV.ULV=SV.ULV-1
  150. 1490    WRITE #1,SV.ULV,SV.ULH,CV,CH
  151. 1500    LOCATE V,H
  152. 1510 RETURN
  153.